--------------------------------------------------------------------------------
-- This package is a thick Ada binding to the GNU Multiple Precision Library.
-- See <http://gmplib.org/>.
--
-- Copyright (C) 2009 Vincent DIEMUNSCH.
-- GNU General Public License.
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU General Public License as published by the Free Software
-- Foundation, either version 3 of the License, or (at your option) any later
-- version.
--
-- This file is distributed in the hope that it will be useful, but WITHOUT ANY
-- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-- A PARTICULAR PURPOSE. See the GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License along with
-- this program.  If not, see <http://www.gnu.org/licenses/>.
----------------------------------------------------------------------------------
--
-- This package declares a new private type : Unbounded_Integer, that is an
-- abstraction of Integer value of arbitrary size.

with Ada.Text_IO; use Ada.Text_IO;

with Ada.Characters.Handling;
with Ada.Strings.Fixed;

package body GMP.Integers is

   --------------------------
   -- To_Unbounded_Integer --
   --------------------------

   function To_Unbounded_Integer (Value : Integer) return Unbounded_Integer
   is
      mpz : mpz_t;
   begin
      mpz_init_set_si (mpz, long(Value));
      return (Ada.Finalization.Controlled with mpz);
   end To_Unbounded_Integer;

   --------------------------
   -- To_Unbounded_Integer --
   --------------------------

   function To_Unbounded_Integer (Value : mpz_t) return Unbounded_Integer is
   begin
      return (Ada.Finalization.Controlled with Value);
   end To_Unbounded_Integer;


   --------------------------
   -- To_Unbounded_Integer --
   --------------------------

   function To_Unbounded_Integer (Image : String) return Unbounded_Integer
   is
      use Ada.Strings.Fixed;
      Result, Base_xx_Exponent : mpz_t;
      First, Last              : Natural;
      Base                     : Base_Arg range 2 .. 62 := 10;
      Exponent                 : Unsigned_long          :=  0;
      Negative                 : Boolean                := False;
      Function_Name            : constant String := "To_Unbounded_Integer : ";
      Based_Literal            : constant String := "Invalid Based Literal";                  

   begin

      If Image(Image'First) = '-' then
         Negative := True;
      end if;

      -- 1) find if it is a based literal
      First := Index (Image, "#");
      if First /= 0 then
         -- It is a based literal !
         Last := Index (Image (First+1 .. Image'Last), "#");
         if Last = 0 then
            raise Data_Error with Function_Name
                                  &" couldn't find ending # in based literal";
         end if;
         if Negative then
            Base := Base_Arg'Value (Image (Image'First+1 .. First-1));
         else
            Base := Base_Arg'Value (Image (Image'First..First-1));
         end if;
         if Last < Image'Last then
            if Image(Last+1) = 'E' or else Image(Last+1) = 'e' then
               Exponent := Unsigned_long'Value (Image(Last+2 .. Image'Last));
            else
               raise Data_Error with Function_Name & Based_Literal;
            end if;
         end if;
         First := First + 1;
         Last  := Last  - 1;

      else
         -- It is a decimal literal !
         if Negative then
            First := Image'First + 1;
         else
            First := Image'First;
         end if;

         Last  := Image'Last;
         For i in First+1 .. Image'Last loop
            if Image(i) = 'E' or else Image(i) = 'e' then
               Last     := i - 1;
               Exponent := unsigned_long'Value (Image(Last+2 .. Image'Last));
               exit;
            end if;
         end loop;
      end if;


      -- 2) suppress "_", check the digits are correct
      declare
         subtype Index_T is Integer range 0 .. Last - First + 1;
         C_Image             : string (1 .. Index_T'Last);
         C_Last              : Index_T;
         C_String            : chars_ptr;
		 Result_Is_Erroneous : int;  
      begin
         C_Last := 0;
         for i in First .. Last loop
            if Image(i) /= '_' then
               C_Last := C_Last + 1;
               if Base > 10 and then Base <= 36 then
                  C_Image(C_Last) := Ada.Characters.Handling.To_Upper(Image(i));
               else
                  C_Image(C_Last) := Image(i);
               end if;
               if Character'Pos(C_Image(C_Last)) <  Character'Pos('0') or else
                  Character'Pos(C_Image(C_Last)) >= Character'Pos('0') + Base
               then
                  raise Data_Error with Function_Name
                                      & "Found an invalid digit in literal";
               end if;
            end if;
         end loop;
         C_String := New_String(C_Image(1 .. C_Last));
	     mpz_init_set_str (Result_Is_Erroneous, Result, C_String, base);
         Free(C_String);
		 if Result_is_Erroneous /= 0 then
		     raise Data_Error with Function_Name 
							     & "Result of GMP's init is erroneous";
		 end if;
      end;

      if Exponent /= 0 then
         mpz_init (Base_xx_Exponent);
         mpz_ui_pow_ui (Base_xx_Exponent, unsigned_long(Base), Exponent);
         mpz_mul (Result, Result, Base_xx_Exponent);
         mpz_clear (Base_xx_Exponent);
      end if;
      if Negative then
         mpz_neg (Result, Result);
      end if;
      return (Ada.Finalization.Controlled with Result);
   exception
      when Data_Error => raise;
      when Others     => raise Data_Error with Function_Name & "Invalid Literal";
   end To_Unbounded_Integer;

   -------------------------------
   -- "=", "<", "<=", ">", ">=" --
   -------------------------------

  function "=" (Left, Right : Unbounded_Integer) return Boolean is
   begin
      return (mpz_cmp (Left.Value, Right.Value) = 0);
   end "=";

    function "<" (Left, Right : Unbounded_Integer) return Boolean is
   begin
      return (mpz_cmp (Left.Value, Right.Value) < 0);
   end "<";

    function "<=" (Left, Right : Unbounded_Integer) return Boolean is
   begin
      return (mpz_cmp (Left.Value, Right.Value) <= 0);
   end "<=";

    function ">" (Left, Right : Unbounded_Integer) return Boolean is
   begin
      return (mpz_cmp (Left.Value, Right.Value) > 0);
   end ">";

    function ">=" (Left, Right : Unbounded_Integer) return Boolean is
   begin
      return (mpz_cmp (Left.Value, Right.Value) >= 0);
   end ">=";

   --------------------
   -- Unary "+", "-" --
   --------------------

   function "+" (Right : Unbounded_Integer) return Unbounded_Integer is
   begin
      return Right;
   end "+";

   function "-" (Right : Unbounded_Integer) return Unbounded_Integer is
      Result : Unbounded_Integer;
   begin
      mpz_neg (Result.Value, Right.Value);
      return Result;
   end "-";

   -----------
   -- "abs" --
   -----------
   function "abs" (Right : Unbounded_Integer) return Unbounded_Integer is
      Result : Unbounded_Integer;
   begin
      mpz_abs (Result.Value, Right.Value);
      return Result;
   end "abs";

   ---------
   -- "+" --
   ---------

   function "+" (Left, Right : Unbounded_Integer) return Unbounded_Integer is
      Result : mpz_t;
   begin
      mpz_init(Result);
      mpz_add (Result, Left.Value, Right.Value);
      return  (Ada.Finalization.Controlled with Result);
   end "+";

   ---------
   -- "-" --
   ---------

   function "-"   (Left, Right : Unbounded_Integer) return Unbounded_Integer is
      Result : Unbounded_Integer;
   begin
      mpz_sub (Result.Value, Left.Value, Right.Value);
      return Result;
   end "-";

   ---------
   -- "*" --
   ---------

   function "*"   (Left, Right : Unbounded_Integer) return Unbounded_Integer is
      Result : Unbounded_Integer;
   begin
      mpz_mul (Result.Value, Left.Value, Right.Value);
	  return Result;
   end "*";


   -- ARM :
   -- Signed integer division and remainder are defined by the relation:
   -- A = (A/B)*B + (A rem B), where (A rem B) has the sign of A and an absolute
   -- value less than the absolute value of B. Signed integer division satisfies
   -- the identity: (-A)/B = -(A/B) = A/(-B).
   -- The signed integer modulus operator is defined such that the result of
   -- A mod B has the sign of B and an absolute value less than the absolute
   -- value of B; in addition, for some signed integer value N, this result
   -- satisfies the relation: A = B*N + (A mod B)

   ----------------
   -- "/", "rem" --
   ----------------

   function "/"   (Left, Right : Unbounded_Integer) return Unbounded_Integer is
      Result : Unbounded_Integer;
   begin
      mpz_tdiv_q (Result.Value, Left.Value, Right.Value);
      return Result;
   end "/";

   function "rem"   (Left, Right : Unbounded_Integer) return Unbounded_Integer is
      Result : Unbounded_Integer;
   begin
      mpz_tdiv_r (Result.Value, Left.Value, Right.Value);
      return Result;
   end "rem";

   -----------
   -- "mod" --
   -----------

   function "mod"   (Left, Right : Unbounded_Integer) return Unbounded_Integer is
      Result : Unbounded_Integer;
   begin
      mpz_fdiv_r (Result.Value, Left.Value, Right.Value);
      return Result;
   end "mod";

   ----------
   -- "**" --
   ----------

   function "**"  (Left : Unbounded_Integer; Right : Natural)
                   return Unbounded_Integer
   is
      Result : mpz_t;
   begin
      mpz_init(Result);
      mpz_pow_ui (Result, Left.Value, unsigned_long(Right));
      return  (Ada.Finalization.Controlled with Result);
   end "**";

   -------------------------
   -- To_Standard_Integer --
   -------------------------

   Procedure To_Standard_Integer(Item     : in  Unbounded_Integer;
                                 Target   : out Integer;
                                 Is_Valid : out Boolean) is
   begin
      -- Warning : we make the assumption that Integer and C.int are the same..
      --           this is always true for GNAT/GCC but not for others !
      if mpz_fits_sint_p(Item.Value) /= 0 then
         Is_Valid := True;
         Target   := Integer(mpz_get_si(Item.Value));
      else
         Is_Valid := False;
         Target   := 0;
      end if;
   end To_Standard_Integer;


   -----------
   -- Image --
   -----------

   function Image (Object : Unbounded_Integer;
                   Base   : Base_Range := 10 )
                   return String
   --  we allcate ourselves the C string "GMP_Image" to be sure that we can
   --  de-allocate it properly and need not call the free function of GMP.
   -- (a bug occured when GMP was not compiled on the same machine...)
   -- WARNING : Free(Item : chars_ptr) will deallocate only until the first Null
   --           character !
   is
     GMP_Image     : string (1 .. integer(mpz_sizeinbase(Object.Value, int(Base))+1))
	           := (Others => ' ');
     GMP_Image_Ptr : chars_ptr := New_String(GMP_Image);
   begin
      GMP_Image_ptr := mpz_get_str (GMP_Image_ptr, int(Base), Object.Value);
      declare
         Result : String := Value(GMP_Image_ptr);
      begin
	 Free(GMP_Image_Ptr);
         if Base = 10 then
            return Result;
         else
            return Integer'Image(Base) &"#"& Result &"#";
         end if;
      end;
   end Image;

   -------------------
   -- To_Long_Float --
   -------------------

   function To_Long_Float (Value : Unbounded_Integer) return Long_Float
   is begin
      return Long_Float(mpz_get_d(Value.Value));
   end To_Long_Float;


   -----------------------------------------------------------------------------
   --                   Number Theoretic Functions                            --
   -----------------------------------------------------------------------------
   
   ---------
   -- GCD --
   ---------
   function GCD (A, B : Unbounded_Integer) return Unbounded_Integer is
      Result : mpz_t;
   begin
      mpz_init(Result);
      mpz_gcd (Result, A.Value, B.Value);
      return  (Ada.Finalization.Controlled with Result);
   end GCD;
   

   ------------------
   -- Extended_GCD --
   ------------------
   procedure Extended_GCD (A, B             :     Unbounded_Integer;
                           Coeff_A, Coeff_B : out Unbounded_Integer;
                           GCD              : out Unbounded_Integer)
   is begin
      mpz_gcdext (G => GCD.Value,
                  S => Coeff_A.Value,
                  T => Coeff_B.Value,
                  A => A.Value,
                  B => B.Value);
   end Extended_GCD;


   ----------------
   -- Initialize --
   ----------------

   procedure Initialize (Object: in out Unbounded_Integer) is
   begin
      mpz_init (Object.Value);
   end Initialize;

   ------------
   -- Adjust --
   ------------

   procedure Adjust (Object: in out Unbounded_Integer) is
      mpz : mpz_t := Object.Value;
   begin
      mpz_init_set (Object.value, mpz);
   end Adjust;

   --------------
   -- Finalize --
   --------------

   procedure Finalize (Object: in out Unbounded_Integer) is
   begin
      mpz_clear(Object.Value);
   end Finalize;

end GMP.Integers;
